home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / debug / mini-command.scm < prev    next >
Text File  |  1995-10-13  |  2KB  |  66 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4. ; Miniature command processor.
  5.  
  6. (define (command-processor ignore args)
  7.   (let ((in (current-input-port))
  8.     (out (current-output-port))
  9.     (batch? (member "batch" args)))
  10.     (let loop ()
  11.       ((call-with-current-continuation
  12.      (lambda (go)
  13.        (with-handler
  14.            (lambda (c punt)
  15.          (cond ((or (error? c) (interrupt? c))
  16.             (display-condition c out)
  17.             (go (if batch?
  18.                 (lambda () 1)
  19.                 loop)))
  20.                ((warning? c)
  21.             (display-condition c out))
  22.                (else (punt))))
  23.          (lambda ()
  24.            (if (not batch?) (display "- " out))
  25.            (let ((form (read in)))
  26.          (cond ((eof-object? form)
  27.             (newline out)
  28.             (go (lambda () 0)))
  29.                ((and (pair? form) (eq? (car form) 'unquote))
  30.             (case (cadr form)
  31.               ((load)
  32.                (mini-load in)
  33.                (go loop))
  34.               ((go)
  35.                (let ((form (read in)))
  36.                  (go (lambda ()
  37.                    (eval form (interaction-environment))))))
  38.               (else (error "unknown command" (cadr form)))))
  39.                (else
  40.             (call-with-values
  41.                 (lambda () (eval form (interaction-environment)))
  42.               (lambda results
  43.                 (for-each (lambda (result)
  44.                     (write result out)
  45.                     (newline out))
  46.                       results)
  47.                 (go loop))))))))))))))
  48.  
  49. (define (mini-load in)
  50.   (let ((c (peek-char in)))
  51.     (cond ((char=? c #\newline) (read-char in) #t)
  52.       ((char-whitespace? c) (read-char in) (mini-load in))
  53.       (else
  54.        (let ((filename (read-string in char-whitespace?)))
  55.          (load filename)
  56.          (mini-load in))))))
  57.  
  58. (define (read-string port delimiter?)
  59.   (let loop ((l '()) (n 0))
  60.     (let ((c (peek-char port)))
  61.       (cond ((or (eof-object? c)
  62.                  (delimiter? c))
  63.              (list->string (reverse l)))
  64.             (else
  65.              (loop (cons (read-char port) l) (+ n 1)))))))
  66.